/*
 * Simple cpp source generator for qtHarbour bindings
 * (C) 2010 Teo Fonrouge
 */

STATIC fh
STATIC clsName
STATIC varName := "obj"
STATIC indentVal := "    "
STATIC lastIf

FUNCTION Main( fileName )

    //SetMode( 40, 80 )

    IF !Empty( fileName )
        ? "Generating bindings for " + fileName

        ProcessHBSource( fileName )

        ?? "   Done."
        ?
    END

RETURN NIL

STATIC PROCEDURE ProcessHBSource( fileName )
    LOCAL aText
    LOCAL itm
    LOCAL line
    LOCAL hBuf,hIf
    LOCAL key,value

    fh := HB_FCreate( "__replace.txt" )

    aText := Text2Array( HB_MemoRead( fileName ) )

    FOR EACH itm IN aText

        line := LTrim( itm )

        IF line = "CLASS "
            clsName := LTrim( RTrim( Token( line, " ", 2 ) ) )
        ENDIF

        IF line = "varname"
            varName := LTrim( RTrim( Token( line, ":", 2 ) ) )
        ENDIF

        IF line = "/* QTH_GEN"
            hBuf := HB_HSetOrder( {=>}, .T. )
            lastIf := "DEFAULT"
            hIf := HB_HSetOrder( { lastIf => {=>} }, .T. )
        ENDIF

        IF line = "QTH_GEN */"
            IF !Empty( hBuf )
                ProcessMethod( hBuf, hIf )
            ENDIF
            hBuf := NIL
        ENDIF

        IF line = "if("
            lastIf := line
            hIf[ lastIf ] := HB_HSetOrder( {=>}, .T. )
        ENDIF

        IF line = "}"
            lastIf := NIL
        ENDIF

        IF hBuf != NIL
            key := Token( line, ":", 1 )
            value := LTrim( SubStr( line, Len( key ) + 2 ) )
            SWITCH key
            CASE "param"
                IF !HB_HHasKey( hIf[lastIf], key )
                    hIf[lastIf,key] := {}
                ENDIF
                key := Token( value, " ", 1 )
                AAdd( hIf[lastIf,"param"], { key, LTrim( SubStr( value, Len( key ) + 1 ) ) } )
                EXIT
            CASE "return"
                hIf[lastIf,key] := value
                EXIT
            OTHERWISE
                hBuf[ key ] := LTrim( RTrim( Token( line, ":", 2 ) ) )
            ENDSWITCH
        ENDIF

    NEXT

    FClose( fh )

RETURN

STATIC PROCEDURE ProcessMethod( hBuf, hIf )
    LOCAL retPrefix
    LOCAL retSuffix
    LOCAL itm
    LOCAL nIndent
    
    FWrite( fh, "HB_FUNC( " + Upper( clsName ) + "_" + Upper( hBuf["name"] ) + E" )\n" )
    FWrite( fh, E"{\n" )
    FWrite( fh, indentVal + clsName + "* " + varName + " = (" + clsName + " *) xho_itemListGet_XHO( hb_stackSelfItem() );"+ E"\n\n" )
    FWrite( fh, indentVal + "if( " + varName + E" )\n" )
    FWrite( fh, indentVal + E"{\n" )

    FOR EACH itm IN hIf
    
        retPrefix := ""
        retSuffix := ""
    
        IF itm:__enumIndex() > 1 .OR. Len( hIf ) = 1
        
            nIndent := 2
            
            FWrite( fh, Replicate( indentVal, nIndent ) )
            
            IF !itm:__enumKey() == "DEFAULT"
                FWrite( fh, itm:__enumKey() + E"\n" )
                FWrite( fh, Replicate( indentVal, nIndent ) + E"{\n" )
                FWrite( fh, Replicate( indentVal, nIndent + 1 ) )
            ELSE
                //FWrite( fh, Replicate( indentVal, nIndent ) )
            ENDIF
            
            IF HB_HHasKey( itm, "return" )
                GetReturn( itm["return"], NIL, @retPrefix, @retSuffix )
            ENDIF
            
            
            FWrite( fh, retPrefix + varName + "->" + hBuf["name"] + "(" )
            
            IF HB_HHasKey( itm, "param" )
                FWrite(fh, GetParam( itm["param"] ) )
            ENDIF

            FWrite( fh, ")" + retSuffix + E";\n" )
            
            IF !itm:__enumKey() == "DEFAULT"
                //--nIndent
                FWrite( fh, Replicate( indentVal, nIndent + 1 ) + E"return;\n" )
                FWrite( fh, Replicate( indentVal, nIndent ) + E"}\n" )
            ENDIF

        ENDIF
        
        ?? "."

    NEXT

    FWrite( fh, indentVal + E"}\n" )

    FWrite( fh, E"}\n\n" )

RETURN

STATIC FUNCTION GetParam( hParam )
    LOCAL param := ""
    LOCAL cParam
    LOCAL cParamType
    LOCAL nParam
    LOCAL itm
    LOCAL index0

    nParam := 0

    FOR EACH itm IN hParam
        index0 := ""
        SWITCH ValType( itm )
        CASE "C"
            EXIT
        CASE "A"
            cParam := itm[ 1 ]
            cParamType := itm[ 2 ]
            SWITCH Token( cParam, "&*", 1 )
            CASE "bool"
                param += " hb_parl( "
                EXIT
            CASE "int"
                IF cParamType == "index0"
                    index0 := " - 1"
                ELSE
                    IF !Empty( cParamType )
                        param += " (" + cParamType + ")"
                    ENDIF
                ENDIF
                param += " hb_parni( "
                EXIT
            CASE "char"
                param += " qth_parc( "
                EXIT
            CASE "object"
                IF !Empty( cParamType )
                    param += " " + iif( Right( cParam, 1 ) = "&", "*", "" ) + "(" + cParamType + " *)"
                ENDIF
                param += " xho_par_XhoObject( "
                EXIT
            ENDSWITCH
            param += LTrim( Str( ++nParam, 0 ) ) + " )" + index0 + ","
            EXIT
        ENDSWITCH
    NEXT

    IF Right( param, 1 ) == ","
        param := Left( param, Len( param ) - 1 ) + " "
    ENDIF

RETURN param

STATIC FUNCTION GetReturn( key, value, retPrefix, retSuffix )
    LOCAL ret := ""
    LOCAL type
    LOCAL subType
    LOCAL index0 := ""
    
    HB_SYMBOL_UNUSED( value )

    type := Token( key, " ", 1 )
    subType := LTrim( RTrim( SubStr( key, Len( type ) + 1 ) ) )
    
    SWITCH Token( type,"&*",1 )
    CASE "bool"
        retPrefix := "hb_retl( "
        EXIT
    CASE "custom"
        retPrefix := subType + " "
        EXIT
    CASE "int"
        IF subType == "index0"
            index0 := " + 1"
        ENDIF
        retPrefix := "hb_retni( "
        EXIT
    CASE "object"
        retPrefix := "xho_itemReturn( "
        IF Right( type, 1 ) = "&"
            retPrefix += "*("
        ELSE
            retPrefix += "("
        ENDIF
        IF Empty( subType )
            retPrefix += "QObject *) "
        ELSE
            retPrefix += subType + " *) "
        ENDIF
        EXIT
    CASE "QString"
        retPrefix := "qth_retc( "
        EXIT
    ENDSWITCH
    
    IF !Empty( retPrefix )
        retSuffix := index0 + " )"
    ENDIF

RETURN ret

STATIC FUNCTION Text2Array( cText )
    LOCAL a := {}
    LOCAL n

    // solo LF como EOL
    cText := StrTran( cText, Chr(13)+Chr(10), Chr(10) )
    cText := StrTran( cText, Chr(9), "  " )

    WHILE !cText==""
        IF (n:=At( Chr(10), cText )) = 0
            n := Len( cText ) + 1
        ENDIF
        AAdd( a, SubStr( cText, 1, n-1 ) )
        cText := SubStr( cText, n+1 )
    ENDDO

RETURN a
